﻿(*   Copyright 2011 Alexander Omelchuk
 *
 *   Licensed under the Apache License, Version 2.0 (the "License");
 *   you may not use this file except in compliance with the License.
 *   You may obtain a copy of the License at
 *
 *       http://www.apache.org/licenses/LICENSE-2.0
 *
 *   Unless required by applicable law or agreed to in writing, software
 *   distributed under the License is distributed on an "AS IS" BASIS,
 *   WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
 *   See the License for the specific language governing permissions and
 *   limitations under the License.
 *)

namespace Lisp

module EvalHelpers =
  open System.Linq.Expressions
  open Helpers

  //<summary>Get the name of Id or throw an exception.</summary>
  let symbolName = function
    | Id name -> name
    | x -> raiseExprError isNotId x

  //<summary>Get the name of Id with check that is not a constant or throw an exception.</summary>
  let mutableName x =
    match x with
    | Id name -> if GEnvironment.IsConstant name
                 then raiseExprError isConstant x
                 name
    | _ -> raiseExprError isNotId x

  //<summary>Check that SExpr is Id or throw an exception.</summary>
  let checkSymbol = function
    | Id _ -> ()
    | x -> raiseExprError isNotId x

  ///<summary>Check that SExpr is Id and not a constant or throw an exception.</summary>
  let checkMutable x =
    match x with
    | Id name -> if GEnvironment.IsConstant name
                 then raiseExprError isConstant x
    | x -> raiseExprError isNotId x

  let checkList = function
    | Lst _ | Nil-> ()
    | x -> raiseExprError isNotList x

  let newTuple<'T1,'T2> obj1 obj2 =
    let constructor' = typeof<'T1 * 'T2>.GetConstructors().[0]
    Expression.New(constructor', [| obj1; obj2 |]) :> Expression

  // LambdaList

  type LLState =
    | Req  = 0
    | Opt  = 1
    | Rest = 2
    | Key  = 3
    | AOK  = 4
    | Aux  = 5

  let getVarDef = function
    | Lst2(var,initForm,Nil) -> mutableName var, initForm
    | Lst(var,Nil)           -> mutableName var, Nil
    | Lst _ as x             -> raiseExprError varDefTooLong x
    | var                    -> mutableName var, Nil

  let getOptArg = function
  | Lst(name,Nil)              -> mutableName name, Nil, ""
  | Lst2(name,init,Nil)        -> mutableName name, init, ""
  | Lst3(name,init,pName,Nil)  -> mutableName name, init, mutableName pName
  | Lst _ as x                 -> raiseExprError varSpecTooLong x
  | name                       -> mutableName name, Nil, ""

  let getLambdaList takeDEnv lst =
    checkList lst
    let state = ref LLState.Req 
    let reqList, optList, restVar, keyList, aok, auxList
      = ref [], ref [], ref None, ref [], ref false, ref []

    let handleArg arg =
      let setState state' =
        if !state >= state' then raiseExprError badPlacedLLKeyword arg
        else state := state'
      match arg with
      | Id "&OPTIONAL" -> setState LLState.Opt
      | Id "&REST"     -> setState LLState.Rest
      //| Id "&KEY"      -> setState LLState.Key
      | Id "&AUX"      -> setState LLState.Aux
      | Id "&ALLOW-OTHER-KEYS" ->
        if !state <> LLState.Opt then raiseExprError badPlacedLLKeyword arg
        else aok := true
             state := LLState.AOK
      | _ -> match !state with
              | LLState.Req  -> reqList := list.Cons(mutableName arg, !reqList)
              | LLState.Opt  -> optList := list.Cons(getOptArg arg, !optList)
              | LLState.Rest -> if restVar.Value.IsNone then restVar := Some (mutableName arg)
                                else raiseExprError tooManyRestArgs arg
              | LLState.Key  -> () //TODO
              | LLState.AOK  -> raiseExprError varAfterAOK arg
              | LLState.Aux  -> auxList := list.Cons(getVarDef arg, !auxList)
              | _ -> failwith (sprintf "unsupported lambda list state %A" !state)
    
    iter handleArg lst
    LambdaList(List.rev !reqList, List.rev !optList, !restVar, List.rev !auxList, takeDEnv)